#load required packages
library(tidyverse)
library(leaflet)
library(sp)
library(sf)
library(rgdal)

#Data Manipulation

#load data
df <- read_csv('jan_dec.csv')
Parsed with column specification:
cols(
  .default = col_double(),
  tpep_pickup_datetime = col_datetime(format = ""),
  tpep_dropoff_datetime = col_datetime(format = ""),
  store_and_fwd_flag = col_character()
)
See spec(...) for full column specifications.
#replace Inf values with 0
df <-  do.call(data.frame,lapply(df, function(x) replace(x, is.infinite(x),0)))
Error in as.POSIXct.numeric(value) : 'origin' must be supplied
#replace Inf values with 0
df <- df %>%
  mutate(avg_mph = ifelse(avg_mph == Inf, 0, avg_mph))

#Data by Pickup Zone

df_pu <- df %>%
  group_by(PULocationID) %>%
  summarize(passenger_count = mean(passenger_count),
            fare_amount = mean(fare_amount),
            trip_distance = mean(trip_distance),
            extra = mean(extra),
            mta_tax = mean(mta_tax),
            tip_amount = mean(tip_amount),
            tolls_amount = mean(tolls_amount),
            total_amount = mean(total_amount),
            fare_by_dist = mean(fare_by_dist),
            duration = mean(duration),
            avg_mph = mean(avg_mph),
            adj_total = mean(adj_total))

#Within Zone Data

df_within <- df %>%
  filter(PULocationID == DOLocationID) %>%
    group_by(PULocationID) %>%
  summarize(passenger_count = mean(passenger_count),
            fare_amount = mean(fare_amount),
            trip_distance = mean(trip_distance),
            extra = mean(extra),
            mta_tax = mean(mta_tax),
            tip_amount = mean(tip_amount),
            tolls_amount = mean(tolls_amount),
            total_amount = mean(total_amount),
            fare_by_dist = mean(fare_by_dist),
            duration = mean(duration),
            avg_mph = mean(avg_mph),
            adj_total = mean(adj_total))

#Pickup Volume Data

df_volume <- df %>%
  group_by(PULocationID) %>%
  tally()
taxi_zones <- readOGR("taxi_zones/taxi_zones.shp")
OGR data source with driver: ESRI Shapefile 
Source: "/Users/athvedt/Documents/GitHub/Data Visualization/Group_W/taxi_zones/taxi_zones.shp", layer: "taxi_zones"
with 263 features
It has 6 fields
#transform polygon
proj <- spTransform(taxi_zones, '+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs')

Map 1 - Average Tip by Pickup Zone

content <- paste("Neighborhood:", taxi_zones$zone, "<br/>",
                 "Average Tip:", "$", round(df_pu$tip_amount, digits = 2), "<br/>")

bins <- c(0, 1, 2, 3, 4, 5, 15)
pal <- colorBin("Greens", domain = df_pu$tip_amount, bins = bins)

leaflet(df_pu) %>%
  addTiles() %>%
  setView(lng = -73.98928, lat = 40.75042, zoom = 10.2) %>%
  addProviderTiles("CartoDB.Positron") %>%
  addPolygons(data = proj,
              popup = content,
              weight = 1,
              fillColor = ~pal(df_pu$tip_amount),
              fillOpacity = 1,
              highlightOptions = highlightOptions(
                color='#000000',
                weight = 3,
                bringToFront = TRUE,
                sendToBack = TRUE),
              label = taxi_zones$zone) %>%
  addLegend("topright",
            pal = pal,
            values = df_pu$tip_amount,
            title = "Average Credit Card Tip (USD)",
            opacity = 1,
            labFormat = labelFormat(prefix = "$"))

Map 2 - Average Speed

#Issues - No data for certain zones, shows “NA” on map

content <- paste("Neighborhood:", taxi_zones$zone, "<br/>",
                 "Average Speed (MPH):", round(df_within$avg_mph, digits = 5), "<br/>")


leaflet(df_within) %>%
  addTiles() %>%
  setView(lng = -73.98928, lat = 40.75042, zoom = 10.2) %>%
  addProviderTiles("CartoDB.Positron") %>%
  addPolygons(data = proj,
              popup = content,
              weight = 1,
              fillColor = ~colorQuantile("RdYlGn", df_within$avg_mph)(df_within$avg_mph),
              fillOpacity = 1,
              highlightOptions = highlightOptions(
                color='#000000',
                weight = 3,
                bringToFront = TRUE,
                sendToBack = TRUE),
              label = taxi_zones$zone) %>%
  addLegend("topright",
            pal = colorQuantile("RdYlGn", df_within$avg_mph, n = 5),
            values = df_within$avg_mph,
            title = "Average Speed (Percentile)",
            opacity = 1,)

Map 3 - Pickup Volume

content <- paste("Neighborhood:", taxi_zones$zone, "<br/>",
                 "Number of Pickups", df_volume$n, "<br/>")


leaflet(df_volume) %>%
  addTiles() %>%
  setView(lng = -73.98928, lat = 40.75042, zoom = 10.2) %>%
  addProviderTiles("CartoDB.Positron") %>%
  addPolygons(data = proj,
              popup = content,
              weight = 1,
              fillColor = ~colorQuantile("YlOrRd", df_volume$n)(df_volume$n),
              fillOpacity = 1,
              highlightOptions = highlightOptions(
                color='#000000',
                weight = 3,
                bringToFront = TRUE,
                sendToBack = TRUE),
              label = taxi_zones$zone) %>%
  addLegend("topright",
            pal = colorQuantile("YlOrRd", df_volume$n, n = 5),
            values = df_volume$n,
            title = "Pickup Volume Percentile",
            opacity = 1,)
LS0tCnRpdGxlOiAiRmluYWwgUHJvamVjdCIKYXV0aG9yOiAiQW5kcmV3IFRodmVkdCIKb3V0cHV0OiBodG1sX25vdGVib29rCi0tLQpgYGB7cn0KI2xvYWQgcmVxdWlyZWQgcGFja2FnZXMKbGlicmFyeSh0aWR5dmVyc2UpCmxpYnJhcnkobGVhZmxldCkKbGlicmFyeShzcCkKbGlicmFyeShzZikKbGlicmFyeShyZ2RhbCkKYGBgCiNEYXRhIE1hbmlwdWxhdGlvbgpgYGB7cn0KI2xvYWQgZGF0YQpkZiA8LSByZWFkX2NzdignamFuX2RlYy5jc3YnKQpgYGAKYGBge3J9CiNyZXBsYWNlIEluZiB2YWx1ZXMgd2l0aCAwCmRmIDwtICBkby5jYWxsKGRhdGEuZnJhbWUsbGFwcGx5KGRmLCBmdW5jdGlvbih4KSByZXBsYWNlKHgsIGlzLmluZmluaXRlKHgpLDApKSkKCmBgYApgYGB7cn0KI3JlcGxhY2UgSW5mIHZhbHVlcyB3aXRoIDAKZGYgPC0gZGYgJT4lCiAgbXV0YXRlKGF2Z19tcGggPSBpZmVsc2UoYXZnX21waCA9PSBJbmYsIDAsIGF2Z19tcGgpKQpgYGAKCgojRGF0YSBieSBQaWNrdXAgWm9uZQpgYGB7cn0KZGZfcHUgPC0gZGYgJT4lCiAgZ3JvdXBfYnkoUFVMb2NhdGlvbklEKSAlPiUKICBzdW1tYXJpemUocGFzc2VuZ2VyX2NvdW50ID0gbWVhbihwYXNzZW5nZXJfY291bnQpLAogICAgICAgICAgICBmYXJlX2Ftb3VudCA9IG1lYW4oZmFyZV9hbW91bnQpLAogICAgICAgICAgICB0cmlwX2Rpc3RhbmNlID0gbWVhbih0cmlwX2Rpc3RhbmNlKSwKICAgICAgICAgICAgZXh0cmEgPSBtZWFuKGV4dHJhKSwKICAgICAgICAgICAgbXRhX3RheCA9IG1lYW4obXRhX3RheCksCiAgICAgICAgICAgIHRpcF9hbW91bnQgPSBtZWFuKHRpcF9hbW91bnQpLAogICAgICAgICAgICB0b2xsc19hbW91bnQgPSBtZWFuKHRvbGxzX2Ftb3VudCksCiAgICAgICAgICAgIHRvdGFsX2Ftb3VudCA9IG1lYW4odG90YWxfYW1vdW50KSwKICAgICAgICAgICAgZmFyZV9ieV9kaXN0ID0gbWVhbihmYXJlX2J5X2Rpc3QpLAogICAgICAgICAgICBkdXJhdGlvbiA9IG1lYW4oZHVyYXRpb24pLAogICAgICAgICAgICBhdmdfbXBoID0gbWVhbihhdmdfbXBoKSwKICAgICAgICAgICAgYWRqX3RvdGFsID0gbWVhbihhZGpfdG90YWwpKQpgYGAKCiNXaXRoaW4gWm9uZSBEYXRhCmBgYHtyfQpkZl93aXRoaW4gPC0gZGYgJT4lCiAgZmlsdGVyKFBVTG9jYXRpb25JRCA9PSBET0xvY2F0aW9uSUQpICU+JQogICAgZ3JvdXBfYnkoUFVMb2NhdGlvbklEKSAlPiUKICBzdW1tYXJpemUocGFzc2VuZ2VyX2NvdW50ID0gbWVhbihwYXNzZW5nZXJfY291bnQpLAogICAgICAgICAgICBmYXJlX2Ftb3VudCA9IG1lYW4oZmFyZV9hbW91bnQpLAogICAgICAgICAgICB0cmlwX2Rpc3RhbmNlID0gbWVhbih0cmlwX2Rpc3RhbmNlKSwKICAgICAgICAgICAgZXh0cmEgPSBtZWFuKGV4dHJhKSwKICAgICAgICAgICAgbXRhX3RheCA9IG1lYW4obXRhX3RheCksCiAgICAgICAgICAgIHRpcF9hbW91bnQgPSBtZWFuKHRpcF9hbW91bnQpLAogICAgICAgICAgICB0b2xsc19hbW91bnQgPSBtZWFuKHRvbGxzX2Ftb3VudCksCiAgICAgICAgICAgIHRvdGFsX2Ftb3VudCA9IG1lYW4odG90YWxfYW1vdW50KSwKICAgICAgICAgICAgZmFyZV9ieV9kaXN0ID0gbWVhbihmYXJlX2J5X2Rpc3QpLAogICAgICAgICAgICBkdXJhdGlvbiA9IG1lYW4oZHVyYXRpb24pLAogICAgICAgICAgICBhdmdfbXBoID0gbWVhbihhdmdfbXBoKSwKICAgICAgICAgICAgYWRqX3RvdGFsID0gbWVhbihhZGpfdG90YWwpKQpgYGAKCiNQaWNrdXAgVm9sdW1lIERhdGEKYGBge3J9CmRmX3ZvbHVtZSA8LSBkZiAlPiUKICBncm91cF9ieShQVUxvY2F0aW9uSUQpICU+JQogIHRhbGx5KCkKYGBgCgoKYGBge3J9CnRheGlfem9uZXMgPC0gcmVhZE9HUigidGF4aV96b25lcy90YXhpX3pvbmVzLnNocCIpCmBgYApgYGB7cn0KI3RyYW5zZm9ybSBwb2x5Z29uCnByb2ogPC0gc3BUcmFuc2Zvcm0odGF4aV96b25lcywgJytwcm9qPWxvbmdsYXQgK2VsbHBzPVdHUzg0ICtkYXR1bT1XR1M4NCArbm9fZGVmcycpCmBgYAoKIyMgTWFwIDEgLSBBdmVyYWdlIFRpcCBieSBQaWNrdXAgWm9uZQoKYGBge3J9CmNvbnRlbnQgPC0gcGFzdGUoIk5laWdoYm9yaG9vZDoiLCB0YXhpX3pvbmVzJHpvbmUsICI8YnIvPiIsCiAgICAgICAgICAgICAgICAgIkF2ZXJhZ2UgVGlwOiIsICIkIiwgcm91bmQoZGZfcHUkdGlwX2Ftb3VudCwgZGlnaXRzID0gMiksICI8YnIvPiIpCgpiaW5zIDwtIGMoMCwgMSwgMiwgMywgNCwgNSwgMTUpCnBhbCA8LSBjb2xvckJpbigiR3JlZW5zIiwgZG9tYWluID0gZGZfcHUkdGlwX2Ftb3VudCwgYmlucyA9IGJpbnMpCgpsZWFmbGV0KGRmX3B1KSAlPiUKICBhZGRUaWxlcygpICU+JQogIHNldFZpZXcobG5nID0gLTczLjk4OTI4LCBsYXQgPSA0MC43NTA0Miwgem9vbSA9IDEwLjIpICU+JQogIGFkZFByb3ZpZGVyVGlsZXMoIkNhcnRvREIuUG9zaXRyb24iKSAlPiUKICBhZGRQb2x5Z29ucyhkYXRhID0gcHJvaiwKICAgICAgICAgICAgICBwb3B1cCA9IGNvbnRlbnQsCiAgICAgICAgICAgICAgd2VpZ2h0ID0gMSwKICAgICAgICAgICAgICBmaWxsQ29sb3IgPSB+cGFsKGRmX3B1JHRpcF9hbW91bnQpLAogICAgICAgICAgICAgIGZpbGxPcGFjaXR5ID0gMSwKICAgICAgICAgICAgICBoaWdobGlnaHRPcHRpb25zID0gaGlnaGxpZ2h0T3B0aW9ucygKICAgICAgICAgICAgICAgIGNvbG9yPScjMDAwMDAwJywKICAgICAgICAgICAgICAgIHdlaWdodCA9IDMsCiAgICAgICAgICAgICAgICBicmluZ1RvRnJvbnQgPSBUUlVFLAogICAgICAgICAgICAgICAgc2VuZFRvQmFjayA9IFRSVUUpLAogICAgICAgICAgICAgIGxhYmVsID0gdGF4aV96b25lcyR6b25lKSAlPiUKICBhZGRMZWdlbmQoInRvcHJpZ2h0IiwKICAgICAgICAgICAgcGFsID0gcGFsLAogICAgICAgICAgICB2YWx1ZXMgPSBkZl9wdSR0aXBfYW1vdW50LAogICAgICAgICAgICB0aXRsZSA9ICJBdmVyYWdlIENyZWRpdCBDYXJkIFRpcCAoVVNEKSIsCiAgICAgICAgICAgIG9wYWNpdHkgPSAxLAogICAgICAgICAgICBsYWJGb3JtYXQgPSBsYWJlbEZvcm1hdChwcmVmaXggPSAiJCIpKQpgYGAKCiMjIE1hcCAyIC0gQXZlcmFnZSBTcGVlZAojSXNzdWVzIC0gTm8gZGF0YSBmb3IgY2VydGFpbiB6b25lcywgc2hvd3MgIk5BIiBvbiBtYXAKYGBge3J9CmNvbnRlbnQgPC0gcGFzdGUoIk5laWdoYm9yaG9vZDoiLCB0YXhpX3pvbmVzJHpvbmUsICI8YnIvPiIsCiAgICAgICAgICAgICAgICAgIkF2ZXJhZ2UgU3BlZWQgKE1QSCk6Iiwgcm91bmQoZGZfd2l0aGluJGF2Z19tcGgsIGRpZ2l0cyA9IDUpLCAiPGJyLz4iKQoKCmxlYWZsZXQoZGZfd2l0aGluKSAlPiUKICBhZGRUaWxlcygpICU+JQogIHNldFZpZXcobG5nID0gLTczLjk4OTI4LCBsYXQgPSA0MC43NTA0Miwgem9vbSA9IDEwLjIpICU+JQogIGFkZFByb3ZpZGVyVGlsZXMoIkNhcnRvREIuUG9zaXRyb24iKSAlPiUKICBhZGRQb2x5Z29ucyhkYXRhID0gcHJvaiwKICAgICAgICAgICAgICBwb3B1cCA9IGNvbnRlbnQsCiAgICAgICAgICAgICAgd2VpZ2h0ID0gMSwKICAgICAgICAgICAgICBmaWxsQ29sb3IgPSB+Y29sb3JRdWFudGlsZSgiUmRZbEduIiwgZGZfd2l0aGluJGF2Z19tcGgpKGRmX3dpdGhpbiRhdmdfbXBoKSwKICAgICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDEsCiAgICAgICAgICAgICAgaGlnaGxpZ2h0T3B0aW9ucyA9IGhpZ2hsaWdodE9wdGlvbnMoCiAgICAgICAgICAgICAgICBjb2xvcj0nIzAwMDAwMCcsCiAgICAgICAgICAgICAgICB3ZWlnaHQgPSAzLAogICAgICAgICAgICAgICAgYnJpbmdUb0Zyb250ID0gVFJVRSwKICAgICAgICAgICAgICAgIHNlbmRUb0JhY2sgPSBUUlVFKSwKICAgICAgICAgICAgICBsYWJlbCA9IHRheGlfem9uZXMkem9uZSkgJT4lCiAgYWRkTGVnZW5kKCJ0b3ByaWdodCIsCiAgICAgICAgICAgIHBhbCA9IGNvbG9yUXVhbnRpbGUoIlJkWWxHbiIsIGRmX3dpdGhpbiRhdmdfbXBoLCBuID0gNSksCiAgICAgICAgICAgIHZhbHVlcyA9IGRmX3dpdGhpbiRhdmdfbXBoLAogICAgICAgICAgICB0aXRsZSA9ICJBdmVyYWdlIFNwZWVkIChQZXJjZW50aWxlKSIsCiAgICAgICAgICAgIG9wYWNpdHkgPSAxLCkKYGBgCiMgTWFwIDMgLSBQaWNrdXAgVm9sdW1lCmBgYHtyfQpjb250ZW50IDwtIHBhc3RlKCJOZWlnaGJvcmhvb2Q6IiwgdGF4aV96b25lcyR6b25lLCAiPGJyLz4iLAogICAgICAgICAgICAgICAgICJOdW1iZXIgb2YgUGlja3VwcyIsIGRmX3ZvbHVtZSRuLCAiPGJyLz4iKQoKCmxlYWZsZXQoZGZfdm9sdW1lKSAlPiUKICBhZGRUaWxlcygpICU+JQogIHNldFZpZXcobG5nID0gLTczLjk4OTI4LCBsYXQgPSA0MC43NTA0Miwgem9vbSA9IDEwLjIpICU+JQogIGFkZFByb3ZpZGVyVGlsZXMoIkNhcnRvREIuUG9zaXRyb24iKSAlPiUKICBhZGRQb2x5Z29ucyhkYXRhID0gcHJvaiwKICAgICAgICAgICAgICBwb3B1cCA9IGNvbnRlbnQsCiAgICAgICAgICAgICAgd2VpZ2h0ID0gMSwKICAgICAgICAgICAgICBmaWxsQ29sb3IgPSB+Y29sb3JRdWFudGlsZSgiWWxPclJkIiwgZGZfdm9sdW1lJG4pKGRmX3ZvbHVtZSRuKSwKICAgICAgICAgICAgICBmaWxsT3BhY2l0eSA9IDEsCiAgICAgICAgICAgICAgaGlnaGxpZ2h0T3B0aW9ucyA9IGhpZ2hsaWdodE9wdGlvbnMoCiAgICAgICAgICAgICAgICBjb2xvcj0nIzAwMDAwMCcsCiAgICAgICAgICAgICAgICB3ZWlnaHQgPSAzLAogICAgICAgICAgICAgICAgYnJpbmdUb0Zyb250ID0gVFJVRSwKICAgICAgICAgICAgICAgIHNlbmRUb0JhY2sgPSBUUlVFKSwKICAgICAgICAgICAgICBsYWJlbCA9IHRheGlfem9uZXMkem9uZSkgJT4lCiAgYWRkTGVnZW5kKCJ0b3ByaWdodCIsCiAgICAgICAgICAgIHBhbCA9IGNvbG9yUXVhbnRpbGUoIllsT3JSZCIsIGRmX3ZvbHVtZSRuLCBuID0gNSksCiAgICAgICAgICAgIHZhbHVlcyA9IGRmX3ZvbHVtZSRuLAogICAgICAgICAgICB0aXRsZSA9ICJQaWNrdXAgVm9sdW1lIFBlcmNlbnRpbGUiLAogICAgICAgICAgICBvcGFjaXR5ID0gMSwpCmBgYAoKYGBge3J9CgpgYGAKCg==